home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / DOS.SWG / 0038_National Language Support.pas < prev    next >
Pascal/Delphi Source File  |  1993-11-21  |  17KB  |  559 lines
  1.  
  2. {
  3.   Borland Pascal 7.0 National Language Support, with support for protected
  4.   mode. Written in october 1993 by Helge Olav Helgesen
  5.  
  6.   The purpose of this unit is to give you the ability to write country-
  7.   dependant programs. I won't explain much how it works; since you have the
  8.   source, feel free to explore/change the source.
  9.  
  10.   To do so I have a written a colletion of procedures, which are described
  11.   here:
  12.  
  13.   procedure CreateTable(cc: Word);
  14.     This one creates a new table with the specified country-code. if you
  15.     specify a value of 0, the default country will be loaded. You should
  16.     check for errors thru GetError and PeekError.
  17.   procedure DumpTable  (const name: string);
  18.     This one was written for debugging only, and shoudn't be used. It saves
  19.     the current translation table to the specific file
  20.   procedure Upper(var s: OpenString);
  21.   procedure Lower(var s: OpenString);
  22.     These two translates a string into upper or lower case only.
  23.   function GetError:  word;
  24.   function PeekError: word;
  25.     These two can be used to get (and clear) the result from last
  26.     CreateTable. GetError clears ErrorCode afterwards, while PeekError
  27.     doesn't.
  28.   function Convert2Time(const dt: DateTime): string8;
  29.     This one will create a formatted string containing the time specified
  30.     in DateTime.Hour, DateTime.Min and DateTime.Sec. The string is formatted
  31.     according to the loaded country.
  32.   function Convert2Date(const dt: DateTime): string8;
  33.     This one does the same as the one above, except that a date is returned
  34.     instead.
  35.   function ConvertR2Currency(no: real): string;
  36.     This one will turn a real value into a formatted string, with the county's
  37.     currency symbol placed right.
  38.     The line 'WriteLn(ConvertR2Currency(1234.123));' will result
  39.     In USA:    $1,234.12
  40.     In Norway: Kr 1.234,12
  41.   function UpChar(Ch: Char): Char;
  42.   function LoChar(Ch: Char): Char;
  43.     These two are written with inline statements, and will thus place the
  44.     expanded code into your program's code segment. Since they became
  45.     fairly large, you shoudn't use them too much.
  46.   procedure DumpAllCountries;
  47.     This one is only compiled in real mode, and is only intended to use with
  48.     debugging. It writes all countries that is available to the screen.
  49.   var Table: TTranslationTable;
  50.     This is *the* 256 byte translation table, which contains the mapping to
  51.     upper and lower chars.
  52.   var ErrorCode: word;
  53.     Result from last CreateTable. This is the Dos error code, as described
  54.     in 'Run-time error messages'.
  55.   var CurrTable: word;
  56.     If last CreateTable successed, this contains the country that is loaded.
  57.   var UnitOK: boolean;
  58.     Is TRUE if
  59.       1) Dos 3+ is loaded
  60.       2) Could allocate real-mode memory (DPMI only)
  61.   var CountryInfo: PCountryInfo;
  62.     This is a pointer to the current countrys info table. This pointer should
  63.     never derefenced unless UnitOK is true. It contains only valid data if
  64.   (CurrTable>0) and UnitOK!
  65.  
  66.   I haven't done much to optimize the code. So even small changes may
  67.   increase the speed. If you have any comments, suggestion etc. feel free
  68.   to leave me a note.
  69.  
  70.   You can reach me thru the following nets:
  71.     ILink     - thru Qmail, Programming, ASM and Pascal
  72.     PolarNet  - thru Pascal and Post
  73.     Rime      - thru Common, Pascal and ASM. I'm located at site MIDNIGHT
  74.     ScanNet   - virtually any conference
  75.     SourceNet - thru the Pascal conference
  76.     WEB       - thru the Pascal conference
  77.  
  78.   You may also reach me at the following bulletin boards:
  79.     Group One BBS       - +1 312 752-1258
  80.     Midnight Sun BBS    - +47 755 84 545
  81.     Programmer's BBS    - +47 22 71 41 07
  82.  
  83.   In all cases, my name is HELGE HELGESEN. My mail address is:
  84.   Helge Olav Helgesen
  85.   Box 726
  86.   8001 BODOE
  87.   Norway
  88.  
  89.   Tlf. +47 755 23 694
  90. }
  91. {$S-,B- Do not change these! A change will cause faults! }
  92. {$G+,D+,R-,Q-,L+,O+}
  93. {$IFDEF Windows}Sorry, Windows is not supported...{$ENDIF}
  94.  
  95. unit NLS;
  96.  
  97. interface
  98.  
  99. uses {$IFDEF DPMI}WinAPI,{$ENDIF}Dos;
  100.  
  101. type
  102.   TTranslationTable = array[0..1, 0..127] of char;
  103.   AChar = record { ASCIIZ char from Country Info }
  104.     Letter: char;
  105.     Dummy: byte;
  106.   end; { AChar }
  107.   PCountryInfo = ^TCountryInfo;
  108.   TCountryInfo = record
  109.     DTFormat: word;                { Date/Time format     }
  110.     CurrSym:  array[0..4] of char; { currency symbol      }
  111.     ThouSep,                       { thousand separator   }
  112.     DeciSep,                       { decimal separator    }
  113.     DateSep,                       { date separator       }
  114.     TimeSep:  AChar;               { time separator       }
  115.     CurrFmt:  byte;                { currency format      }
  116.     Digits:   byte;                { digits after decimal }
  117.     TimeFmt:  boolean;             { FALSE=12h else 24h   }
  118.     CaseMap:  pointer;             { real mode case map   }
  119.     DataSep:  AChar;               { data list separator  }
  120.     RFU:      array[0..9] of byte; { not used             }
  121.   end; { TCountryInfo }
  122.   String8 = string[12];
  123.  
  124. var
  125.   Table: TTranslationTable;  { the translation table                   }
  126.   ErrorCode: word;           { error code from last create table       }
  127.   CurrTable: word;           { current country loaded, or 0 if none    }
  128.   UnitOK: boolean;           { true if extentions are allowed          }
  129.   CountryInfo: PCountryInfo; { NB! Protected Mode selector under DPMI! }
  130.  
  131. procedure CreateTable(cp: word);
  132.   { -creates new table }
  133. procedure DumpTable  (const name: string);
  134.   { -saves table to disk, mainly written for debugging purposes }
  135. procedure Upper      (var s: OpenString);
  136.   { -translate string to upper case (A NAME) }
  137. procedure Lower      (var s: OpenString);
  138.   { -translate string to lower case (a name) }
  139. function  GetError:  word;
  140.   { -get and clear error }
  141. function  PeekError: word;
  142.   { -get error }
  143. function  Convert2Time(const dt: DateTime): string8;
  144.   { -converts time part of DateTime rec info country dep. string }
  145. function  Convert2Date(const dt: DateTime): string8;
  146.   { -converts date part into XX:YY:ZZ country dep. }
  147. function  ConvertR2Currency(no: real): string;
  148.   { -converts real value to currency }
  149. function  UpChar(Ch: Char): Char;
  150.   { -converts char to upper case }
  151. inline($58/        { pop ax }
  152.        $88/$c4/    { mov ah, al }
  153.        $a8/$80/    { test al, 80h }
  154.        $74/$10/    { je @1 }
  155.        $8b/$d8/    { mov bx, ax }
  156.        $32/$ff/    { xor bh, bh }
  157.        $8a/$a7/    { mov ah, [bx+ }
  158.        >Table-$80/ { Table-80h] }
  159.        $84/$e4/    { test ah, ah }
  160.        $74/$0d/    { le @2 }
  161.        $88/$e0/    { mov al, ah }
  162.        $eb/$09/    { jmp @2 }
  163. {@1:}  $f6/$d4/    { not ah }
  164.        $f6/$c4/$60/{ test ah, 60h }
  165.        $75/$02/    { jne @2 }
  166.        $34/$20     { xor al, 20h }
  167. {@2:} );
  168. function  LoChar(Ch: Char): Char;
  169.   { -translates Ch to lower char }
  170. inline($58/        { pop ax }
  171.        $a8/$80/    { test al, 80h }
  172.        $74/$10/    { le @1 }
  173.        $8b/$d8/    { mov bx, ax }
  174.        $32/$ff/    { xor bh, bh }
  175.        $8a/$a7/    { mov ah, [bx+ }
  176.        >Table/     { TABLE] }
  177.        $0a/$e4/    { or ah, ah }
  178.        $74/$0c/    { je @2 }
  179.        $88/$e0/    { mov al, ah }
  180.        $eb/$08/    { jmp @2 }
  181. {@1:}  $88/$c4/    { mov ah, al }
  182.        $a8/$c0/    { test al, 0c0h }
  183.        $74/$08/    { je @2 }
  184.        $34/$20     { xor al, 20h }
  185. {@2:} );
  186.  
  187. {$IFDEF MSDOS}
  188. procedure DumpAllCountries;
  189.   { -dumps all country codes supported. For debugging. Works only in real mode }
  190. {$ENDIF}
  191.  
  192. implementation
  193.  
  194. {$IFDEF DPMI}
  195. type
  196.   TBit32 = record
  197.     Low, High: word;
  198.   end; { Bit32 }
  199.   TCallRealMode = record { DPMI structure used to call real mode procs }
  200.     EDI,   ESI, EBP, RFU1, EBX,
  201.     EDX,   ECX, EAX: TBit32;
  202.     Flags, rES, rDS, rFS,
  203.     rGS,   rIP, rCS, rSP,
  204.     rSS:   word;
  205.   end; { TCallRealMode }
  206.  
  207. var
  208.   ciSelector: TBit32;  { selector and segment to CountryInfo     }
  209.   MyExitProc: pointer; { DPMI exit proc to deallocate Dos memory }
  210. {$ENDIF}
  211.  
  212. type
  213.   string2 = string[2];
  214.   Pstring = ^String;
  215.  
  216. function Convert2Digit(no: word): string2;
  217. var
  218.   s: string8;
  219. begin
  220.   Str(no:2, s);
  221.   if s[0]>#2 then delete(s, 1, byte(s[0])-2);
  222.   if s[1]=#32 then s[1]:='0';
  223.   Convert2Digit:=s;
  224. end; { Convert2Digit }
  225.  
  226. {$IFDEF MSDOS}
  227. procedure DumpAllCountries;
  228.   function TestCountry(no: word): boolean; assembler;
  229.   var dummy: TCountryInfo;
  230.   asm
  231.     push ds
  232.     mov  ax, ss
  233.     mov  ds, ax
  234.     lea  dx, dummy
  235.     mov  ax, $38ff
  236.     mov  bx, no
  237.     or   bh, bh
  238.     je   @1
  239.     mov  al, bl
  240. @1: int  $21
  241.     pop  ds
  242.     jc   @x
  243.     xor  ax, ax
  244. @x:
  245.   end; { DumpAllcountries.TestCountry }
  246. var
  247.   x: word;
  248. begin
  249.   for x:=0 to 900 do if not TestCountry(x) then write(x:10);
  250. end; { DumpAllCountries }
  251. {$ENDIF}
  252.  
  253. function Convert2Time;
  254. const
  255.   AM: string2 = 'AM';
  256.   PM: string2 = 'PM';
  257.   function To12(no: word): word;
  258.   begin
  259.     if no>12 then To12:=no-12 else To12:=no;
  260.   end; { Convert2Time.To12 }
  261.   function AmPm(no: word): Pstring;
  262.   begin
  263.     if no>12 then AmPm:=@PM else AmPm:=@AM;
  264.   end; { Convert2Time.AmPm }
  265. var
  266.   Delemiter: char;
  267. begin { Convert2Time }
  268.   if UnitOK and (ErrorCode=0) then
  269.     Delemiter:=CountryInfo^.TimeSep.Letter
  270.   else
  271.     Delemiter:=':';
  272.   if UnitOK and (CurrTable>0) and CountryInfo^.TimeFmt then
  273.     Convert2Time:=Convert2Digit(dt.Hour)+Delemiter+ { time }
  274.                   Convert2Digit(dt.Min)+Delemiter+  { min  }
  275.                   Convert2Digit(dt.Sec)
  276.   else
  277.     Convert2Time:=Convert2Digit(To12(dt.Hour))+Delemiter+ { time }
  278.                   Convert2Digit(dt.Min)+Delemiter+        { min  }
  279.                   Convert2Digit(dt.Sec)+#32+AMPM(dt.Hour)^{ sec  }
  280. end; { Convert2Time }
  281.  
  282. function Convert2Date;
  283. var
  284.   Dele: char;
  285. begin
  286.   if UnitOK and (CurrTable>0) then
  287.     Dele:=CountryInfo^.DateSep.Letter
  288.   else
  289.     Dele:='/';
  290.   if UnitOK and (CurrTable>0) and (CountryInfo^.DTFormat>0) then
  291.   case CountryInfo^.DTFormat of
  292.     1: Convert2Date:=Convert2Digit(dt.Day)+Dele+   { date  }
  293.                      Convert2Digit(dt.Month)+Dele+ { month }
  294.                      Convert2Digit(dt.Year);       { year  }
  295.     2: Convert2Date:=Convert2Digit(dt.Year)+Dele+  { year  }
  296.                      Convert2Digit(dt.Month)+Dele+ { month }
  297.                      Convert2Digit(dt.Day);
  298.   end { case }
  299.   else { if }
  300.     Convert2Date:=   Convert2Digit(dt.Month)+Dele+ { month }
  301.                      Convert2Digit(dt.Day)+Dele+   { day   }
  302.                      Convert2Digit(dt.Year);       { year  }
  303. end; { Convert2Time }
  304.  
  305. function ConvertR2Currency;
  306.   function GetCurrency: string8;
  307.   var
  308.     s: string8;
  309.   begin
  310.     s:=CountryInfo^.CurrSym;
  311.     while s[byte(s[0])]=#0 do dec(s[0]);
  312.     GetCurrency:=s;
  313.   end; { ConvertR2Currency.GetCurrency }
  314.   function FormatString(s: string): string;
  315.   var
  316.     Comma, Digits: byte;
  317.     c: integer;
  318.     Dele: char;
  319.   begin
  320.     Dele:=CountryInfo^.ThouSep.Letter;     { get thousand delemiter          }
  321.     Digits:=Pos('.', s);                   { digits before delemither        }
  322.     Comma:=Digits;                         { save comma position             }
  323.     if Digits=0 then Digits:=Length(s)+1;  { start rightmost if no comma     }
  324.     c:=Digits-3;                           { init counter                    }
  325.     while c>2 do
  326.     begin
  327.       Insert(Dele, s, c);                  { insert thousand delemither      }
  328.       Dec(c, 3);                           { adjust pointer                  }
  329.       if Comma>0 then Inc(Comma);          { increase comma position(if any) }
  330.     end; { while }
  331.     if Comma>0 then                        { adjust comma, if any            }
  332.       s[Comma]:=CountryInfo^.DeciSep.Letter;
  333.     FormatString:=s;
  334.   end; { ConvertR2Currency.FormatString }
  335.   function PlaceCurrency(s: string): string;
  336.   var
  337.     x: byte;
  338.   begin
  339.     x:=Pos(CountryInfo^.DeciSep.Letter, s);
  340.     Delete(s, x, 1);
  341.     Insert(GetCurrency, s, x);
  342.     PlaceCurrency:=s;
  343.   end; { ConvertR2Currency.PlaceCurrency }
  344. var
  345.   s: string[20];
  346. begin { ConvertR2Currency }
  347.   if UnitOK and (CurrTable>0) then
  348.   begin
  349.     Str(no:20:CountryInfo^.Digits, s);
  350.     while s[1]=#32 do delete(s, 1, 1);
  351.     s:=FormatString(s);
  352.   end
  353.   else
  354.   begin
  355.     Str(no:20:2, s);
  356.     while s[1]=#32 do delete(s, 1, 1);
  357.   end; { if/else }
  358.   if UnitOK and (CurrTable>0) then
  359.   case CountryInfo^.CurrFmt of
  360.     0: s:=GetCurrency+s;
  361.     1: s:=s+GetCurrency;
  362.     2: s:=GetCurrency+#32+s;
  363.     3: s:=s+#32+GetCurrency;
  364.     4: s:=PlaceCurrency(s);
  365.   end; { case }
  366.   ConvertR2Currency:=s;
  367. end; { ConvertR2Currency }
  368.  
  369. procedure DumpTable;
  370. var
  371.   f: file of TTranslationTable;
  372. begin
  373.   assign(f, name);
  374.   rewrite(f);
  375.   write(f, Table);
  376.   close(f);
  377. end;
  378.  
  379. procedure CreateTable;
  380. var
  381.   b: byte;
  382.   c, d: char;
  383.   procedure GetCountryInfo(cp: word);
  384.   var
  385.     r: Registers;
  386.   begin
  387.     r.AX:=$38FF;
  388.     if cp>255 then r.BX:=cp else r.AL:=Lo(cp);
  389.     r.DS:=Seg(CountryInfo^);
  390.     r.DX:=Ofs(CountryInfo^);
  391.     MsDos(r);
  392.     if r.Flags and 1=1 then ErrorCode:=r.AX;
  393.     if ErrorCode=0 then CurrTable:=r.BX else CurrTable:=0;
  394.   end; { CreateTable.GetCoutryInfo }
  395.   function CallCaseMap(Letter: char): char; assembler;
  396. {$IFNDEF MSDOS}
  397.   var
  398.     regs: TCallRealMode;
  399. {$ENDIF}
  400.   asm
  401.     mov  al, Letter
  402.   {$IFNDEF MSDOS}
  403.     mov  word ptr regs.EAX, ax
  404.     mov  regs.rSP, 0
  405.     mov  regs.rSS, 0
  406.     les  di, CountryInfo
  407.     mov  ax, word ptr es:[di].TCountryInfo.CaseMap
  408.     mov  regs.RIP, ax
  409.     mov  ax, word ptr es:[di].TCountryInfo.CaseMap+2
  410.     mov  regs.RCS, ax
  411.     mov  ax, ss
  412.     mov  es, ax
  413.     lea  di, regs
  414.     xor  cx, cx
  415.     mov  ax, $301
  416.     int  $31 { execute real mode proc }
  417.     mov  ax, word ptr regs.EAX
  418.   {$ELSE}
  419.     les  di, CountryInfo
  420.     call es:[di].TCountryInfo.CaseMap
  421.   {$ENDIF}
  422.   end; { CreateTable.CallCaseMap }
  423.   procedure MapIn(NewChar, OldChar: char);
  424.   begin
  425.     Table[0, byte(OldChar) and $7f]:=NewChar;
  426.     Table[1, byte(NewChar) and $7f]:=OldChar;
  427.   end; { CreateTable.MapIn }
  428. begin { CreateTable }
  429.   if (ErrorCode>0) or not UnitOK then exit; { leave if any pending error }
  430.   FillChar(Table, sizeof(Table), 0);
  431.   GetCountryInfo(cp);
  432.   if ErrorCode>0 then exit; { leave if any error occured }
  433.   for b:=0 to 127 do
  434.   begin
  435.     c:=CallCaseMap(char(b+128));
  436.     if c<>char(b+128) then MapIn(c, char(b+128));
  437.   end; { for }
  438. end; { CreateTable }
  439.  
  440. procedure UpCase; assembler;
  441. {
  442.   This translates the incoming char in AL into upper case if it is defined
  443.   in the translation table.
  444.   Please note that if you enable stack checking, this proc won't work...
  445. }
  446. asm
  447.   test al, $80
  448.   je   @1
  449.   xor  ah, ah
  450.   mov  bx, ax
  451.   mov  ah, byte[Table+bx-$80]
  452.   test ah, ah
  453.   je   @x
  454.   mov  al, ah
  455.   jmp  @x
  456. @1:
  457.   cmp  al, 'z'
  458.   jg   @x
  459.   cmp  al, 'a'
  460.   jl   @x
  461.   xor  al, $20
  462. @x:
  463. end; { UpChar }
  464.  
  465. procedure LowChar; assembler;
  466. asm
  467.   test al, $80
  468.   je   @1
  469.   mov  bx, ax
  470.   xor  bh, bh
  471.   mov  ah, byte[Table+bx]
  472.   or   ah, ah
  473.   je   @x
  474.   mov  al, ah
  475.   jmp  @x
  476. @1:
  477.   cmp  al, 'Z'
  478.   jg   @x
  479.   cmp  al, 'A'
  480.   jl   @x
  481.   xor  al, $20
  482. @x:
  483. end; { LowChar }
  484.  
  485. procedure Upper; assembler;
  486. asm
  487.   les  di, s
  488.   mov  cl, es:[di]
  489.   xor  ch, ch
  490.   jcxz @x
  491.   inc  di
  492. @1:
  493.   mov  al, es:[di]
  494.   call UpCase
  495.   mov  es:[di], al
  496.   inc  di
  497.   loop @1
  498. @x:
  499. end; { Upper }
  500.  
  501. procedure Lower; assembler;
  502. asm
  503.   les  di, s
  504.   mov  cl, es:[di]
  505.   xor  ch, ch
  506.   jcxz @x
  507.   inc  di
  508. @1:
  509.   mov  al, es:[di]
  510.   call LowChar
  511.   mov  es:[di], al
  512.   inc  di
  513.   loop @1
  514. @x:
  515. end; { Lower }
  516.  
  517. function GetError; assembler;
  518. asm
  519.   mov  ax, ErrorCode
  520.   mov  ErrorCode, 0
  521. end; { GetError }
  522.  
  523. function PeekError; assembler;
  524. asm
  525.   mov  ax, ErrorCode
  526. end; { PeekError }
  527.  
  528. {$IFNDEF MSDOS}
  529. procedure Leave; far;
  530. begin
  531.   ExitProc:=MyExitProc;           { change to old handler }
  532.   GlobalDosFree(ciSelector.High); { release Dos memory    }
  533. end; { Leave }
  534.  
  535. procedure InitExitProc;
  536. begin
  537.   MyExitProc:=ExitProc; { save old handler }
  538.   ExitProc:=@Leave; { save my own handler  }
  539. end; { InitExitProc }
  540. {$ENDIF}
  541.  
  542. begin { NLS }
  543.   UnitOk:=Lo(DosVersion)>=3; { does only work for Dos 3+ }
  544.   if UnitOK then { allocate memory }
  545.   begin
  546.   {$IFDEF DPMI}
  547.     longint(ciSelector):=GlobalDosAlloc(sizeof(TCountryInfo));
  548.     if ciSelector.Low=0 then UnitOK:=False; { if not enough Dos memory }
  549.     CountryInfo:=Ptr(ciSelector.Low, 0); { make protected mode pointer }
  550.     if UnitOK then InitExitProc; { change exit proc                    }
  551.   {$ELSE}
  552.     if MaxAvail>sizeof(CountryInfo^) then{ allocate if enough memory   }
  553.       New(CountryInfo)
  554.     else
  555.       UnitOK:=False; { or disable extentions }
  556.   {$ENDIF}
  557.   end; { if UnitOK }
  558. end.
  559.